home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / TECHNICA / AUTOCAD / H107.ZIP / APR91.ZIP / TIP649.LSP < prev    next >
Text File  |  1991-04-11  |  2KB  |  70 lines
  1. ;TIP649.LSP   English-Metric Unit Replacement   (c)1991, Mel Sloan
  2.  
  3. (defun C:MET_ENG ()
  4.   (setq SNAP1 (getvar "SNAPMODE"))
  5.   (setvar "SNAPMODE" 0)
  6.   (setvar "CMDECHO" 0)
  7.   (setq QUES (strcase (getstring
  8.     "Bypass menu? <Y> ")))
  9.   (if (or (= QUES "Y") (= QUES ""))
  10.     (CON)
  11.     (progn
  12.       (setq CHOICE nil)
  13.       (MENU)
  14.       (CON)
  15.     )
  16.   )
  17. )
  18. (defun MENU ()
  19.   (terpri)
  20.   (prompt
  21.     "   1. Replace English with metric.")
  22.   (prompt
  23.     "   2. Replace metric with English.")
  24.   (terpri)
  25.   (prompt
  26.     "   3. Add Metric to English: E [M]")
  27.   (prompt
  28.     "   4. Add English to Metric: M [E]")
  29.   (while
  30.     (and
  31.       (and
  32.         (and (/= CHOICE 1) (/= CHOICE 2))
  33.         (/= CHOICE 3)) (/= CHOICE 4))
  34.       (setq CHOICE (getint
  35.       "                 Enter choice: "))
  36.   )
  37. )
  38. (defun CON ( / A B COUNT D E FL CALC DATA
  39.      MIX)
  40.   (setq A (ssget)
  41.         B (sslength A)
  42.     COUNT 0)
  43.   (while (< COUNT B)
  44.     (setq D (ssname A COUNT) E (entget D)
  45.     )
  46.     (if (= "TEXT" (cdr (assoc 0 E)))
  47.       (progn
  48.         (setq DATA (cdr (assoc 1 E)))
  49.         (setq FL (atof DATA))
  50.         (if (or (= CHOICE 1)(= CHOICE 3))
  51.           (setq CALC (* FL 25.4))
  52.           (setq CALC (/ FL 25.4))
  53.         )
  54.         (if (or (= CHOICE 1)(= CHOICE 2))
  55.           (setq MIX (rtos CALC))
  56.           (setq MIX (strcat DATA " ["
  57.             (rtos CALC) "]"))
  58.         )
  59.         (setq E (subst (cons 1 MIX)
  60.           (assoc 1 E) E))
  61.         (entmod E)
  62.         (setq COUNT (1+ COUNT))
  63.     )
  64.     (setq COUNT (1+ COUNT))
  65.     )
  66.   )
  67. (setvar "snapmode" SNAP1)
  68. (princ)
  69. )
  70.